home *** CD-ROM | disk | FTP | other *** search
/ Developer CD Series 1998 November: Tool Chest / Dev.CD Nov 98 TC.toast / Sample Code / Snippets / Text / NamingTableAccess / UsfntNamingTable.p < prev   
Encoding:
Text File  |  1992-07-15  |  4.9 KB  |  163 lines  |  [TEXT/PJMM]
  1. unit SfntNamingTable;
  2. { Joseph Maurer, Macintosh Developer Technical Support }
  3. { December 3rd, 1991 }
  4.  
  5. interface
  6. {•  uses •}
  7. {•  Script;  •}
  8.   { for script codes 0 = smRoman, 1 = smJapanese, ..., 31 = smExtArabic, 32 = Uninterp }
  9.   { and language codes 0 = langEnglish, 1 = langFrench, 2 = langGerman, 3 = langItalian, ..., 139 = langSundaneseRom }
  10. {$IFC UNDEFINED THINK_PASCAL}
  11. {$SETC THINK_PASCAL := 0}
  12. {$ENDC}
  13.  
  14. {$IFC NOT THINK_PASCAL}
  15.     uses
  16.         Types, Memory;
  17. {$ENDC}
  18.         
  19. {, QuickDraw, Events, Controls, Desk, Windows, TextEdit, Dialogs, Fonts, Lists, Menus, Resources, Scrap, ToolUtils, OSUtils, Files, Memory, OSEvents, 
  20. SegLoad, DiskInit, Packages, Traps, }
  21.  
  22.     const
  23. { nameID numbers for content of naming table strings }
  24.         kCopyright = 0;
  25.         kFamily = 1;
  26.         kStyle = 2;
  27.         kUnique = 3;
  28.         kFull = 4;
  29.         kVersion = 5;
  30.         kPostscript = 6;
  31.         kTrademark = 7;
  32.         kManufacturer = 8;
  33.  
  34.  
  35.     function NamingTableLookup (sfnt: Handle; var platform, encoding, language, content, index: Integer): Str255;
  36.  
  37. { Returns the name from the naming table which corresponds to the given platform, encoding, language, content ID numbers. }
  38. { A value of -1 for any of these acts as a wildcard; if a name has been found, -1 is replaced by the actual ID. }
  39. { The search should start with index = 0; on return , <index>  points beyond the returned entry, such that the function }
  40. { can be called repeatedly (with wildcard parameters) to find all the names for a given ID specification. }
  41. { If there is no name for a given ID specification in the sfnt, or if an error ocurred,  the empty string is returned.}
  42.  
  43. { platform: 0 = UniChar, no specific encoding;  1 = Macintosh; 2 = ISO }
  44. { encoding: if platform = Macintosh, then encodingID = Macintosh Script Manager code }
  45. {                 if platform = ISO, then encodingID = 0 = 7-bit ASCII, or 1 = ISO 10646, or 2 = ISO 8859-1 }
  46.  
  47.  
  48. implementation
  49.  
  50. { Some of these "hidden" implementation details are inspired by Mike Reed's OutlineAccess code }
  51. { See  d e v e l o p   n° 8 , "Curves ahead " }
  52.  
  53. {$IFC THINK_PASCAL}
  54.     type
  55.         IntegerPtr = ^Integer;
  56. {$ENDC}
  57.  
  58.     function GetNamingTablePtr (sfnt: Handle): IntegerPtr;
  59.         const
  60.             kNumOffset = 4;   { from start of 'sfnt' resource }
  61.             kTableOffset = 12;
  62.         type
  63.             SfntDirectoryEntry = record
  64.                     tableTag: OSType;
  65.                     checkSum: Longint;
  66.                     offset: Longint;
  67.                     iLength: Longint;
  68.                 end;
  69.             SfntTableDirectory = array[0..0] of SfntDirectoryEntry; { actually array[0 .. numOffsets-1] }
  70.             TablePtr = ^SfntTableDirectory;
  71.         var
  72.             p: IntegerPtr;
  73.             dir: TablePtr;
  74.             off: Longint;
  75.             index: Integer;
  76.     begin
  77.         p := IntegerPtr(ord4(sfnt^) + kNumOffset);
  78.         index := p^;  { = number of tables in table directory}
  79.         dir := TablePtr(ord4(sfnt^) + kTableOffset);
  80.         off := 0;
  81.         while index > 0 do
  82.             begin
  83.                 index := index - 1;
  84.                 with dir^[index] do
  85.                     if tableTag = 'name' then
  86.                         begin
  87.                             off := offset;
  88.                             Leave;
  89.                         end;
  90.             end;
  91.         if off > 0 then
  92.             GetNamingTablePtr := IntegerPtr(ord4(sfnt^) + off)
  93.         else
  94.             GetNamingTablePtr := nil;
  95.     end;
  96.  
  97.     function NamingTableLookup (sfnt: Handle; var platform, encoding, language, content, index: Integer): Str255;
  98.         const
  99.             kNumberOfRecs = 2;  { from start of NamingTable }
  100.             kStringStorage = 4;
  101.             kNameRecords = 6;
  102.         type
  103.             SfntNameRecord = record
  104.                     platformID: Integer;
  105.                     encodingID: Integer;
  106.                     languageID: Integer;
  107.                     nameID: Integer;
  108.                     strLength: Integer;
  109.                     strOffset: Integer;
  110.                 end;
  111.             SfntNRArray = array[0..0] of SfntNameRecord; { actually array[0 .. count-1] }
  112.             SfntNRArrayPtr = ^SfntNRArray;
  113.         var
  114.             p0, p: IntegerPtr;
  115.             strStore: Ptr;
  116.             found: Boolean;
  117.             count: Integer;
  118.             s: Str255;
  119.             flags: SignedByte;
  120.     begin
  121.         flags := HGetState(sfnt);
  122.         HLock(sfnt);
  123.         found := false;
  124.         s := '';
  125.         p0 := GetNamingTablePtr(sfnt);
  126.         if p0 <> nil then
  127.             begin
  128.                 p := IntegerPtr(ord4(p0) + kNumberOfRecs);  { points to number of NameRecords in Naming Table in the 'sfnt' }
  129.                 count := p^;
  130.                 p := IntegerPtr(ord4(p0) + kStringStorage);
  131.                 strStore := Ptr(ord4(p0) + p^);  { points to actual string data }
  132.                 p := IntegerPtr(ord4(p0) + kNameRecords);  { now points to nameRecords }
  133.                 while (index < count) and not found do
  134.                     with SfntNRArrayPtr(p)^[index] do
  135.                         begin
  136.                             if (platform = platformID) | (platform = -1) then
  137.                                 if (encoding = encodingID) | (encoding = -1) then
  138.                                     if (language = languageID) | (language = -1) then
  139.                                         found := (content = nameID) | (content = -1);
  140.                             if found then
  141.                                 begin
  142.                                     platform := platformID;
  143.                                     encoding := encodingID;
  144.                                     language := languageID;
  145.                                     content := nameID;
  146.                                 end;
  147.                             index := index + 1;
  148.                         end;
  149.                 if found then
  150.                     with SfntNRArrayPtr(p)^[index - 1] do
  151.                         begin
  152.                             if strLength > 255 then
  153.                                 s[0] := chr(255)
  154.                             else
  155.                                 s[0] := chr(strLength);
  156.                             BlockMove(Ptr(ord4(strStore) + strOffset), @s[1], ord(s[0]));
  157.                         end
  158.             end;
  159.         NamingTableLookup := s;
  160.         HSetState(sfnt, flags);
  161.     end;
  162.  
  163. end.